Assignment 6
Rachel Cardarelli
October 16, 2019
Question 1
#install.packages('gganimate')
#install.packages('gifski')
#install.packages('png')
library(png)
library(gganimate)## Loading required package: ggplot2library(gifski)
library(readxl)
library(stringr)
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(tidyr)
library(ggplot2)
c2015 <- read_excel("c2015.xlsx")
d <- tbl_df(c2015)
d = d %>% filter_all(~!is.na(.))
d = d %>% filter_all(~!(.=='Unknown'))
d = d %>% filter_all(~!(.=='Not Rep'))
d = d %>% filter_all(~!(.==str_detect(.,'Not Rep')))
d = d %>% filter_all(~!(.==str_detect(.,'Unknown')))
d = d %>% filter_all(~!(.=='Not Reported'))
d = d %>% filter(SEAT_POS=='Front Seat, Left Side')
d = d %>% mutate(AGE = as.numeric(AGE))
d = d %>% mutate(TRAV_SP = str_replace(TRAV_SP," MPH",""))
d = d %>% mutate(TRAV_SP = replace(TRAV_SP, TRAV_SP == "Stopped", "0"))
d = d %>% mutate(TRAV_SP = as.numeric(TRAV_SP))
m <- mean(d$TRAV_SP, na.rm = TRUE)
g <- d %>% group_by(SEX, INJ_SEV, MONTH) %>% summarise(mean_sp = mean(TRAV_SP, na.rm = TRUE)) %>% mutate(Speed =
ifelse(mean_sp > m, "Above Average", "Below Average"))
g$mean_sp <- round((g$mean_sp - mean(g$mean_sp))/sd(g$mean_sp), 2)
ggplot(g, aes(MONTH,mean_sp)) +
geom_bar(stat='identity', aes(fill=Speed), width=.5) +
scale_color_manual(name="Speed", labels = c("Above Average", "Below Average"), values = c("above"="#00ba38", "below"="#f8766d")) +
transition_states(MONTH) +
labs(title = 'MONTH = {closest_state}') +
coord_flip()
Question 2
ggplot(d, aes(DRINKING, fill = SEX)) + geom_bar() + transition_states(MONTH) + labs(title = 'MONTH = {closest_state}') + geom_text(stat='count', aes(label=..count..), vjust=-1)
Question 3
#install.packages('datapasta')
library(datapasta)
household <- tibble::tribble(
~Quarter, ~Mortgage, ~HE.Revolving, ~Auto.Loan, ~Credit.Card, ~Student.Loan, ~Other, ~Total,
"03:Q1", 4.94, 0.24, 0.64, 0.69, 0.24, 0.48, 7.23,
"03:Q2", 5.08, 0.26, 0.62, 0.69, 0.24, 0.49, 7.38,
"03:Q3", 5.18, 0.27, 0.68, 0.69, 0.25, 0.48, 7.56,
"03:Q4", 5.66, 0.3, 0.7, 0.7, 0.25, 0.45, 8.07,
"04:Q1", 5.84, 0.33, 0.72, 0.7, 0.26, 0.45, 8.29,
"04:Q2", 5.97, 0.37, 0.74, 0.7, 0.26, 0.42, 8.46,
"04:Q3", 6.21, 0.43, 0.75, 0.71, 0.33, 0.41, 8.83,
"04:Q4", 6.36, 0.47, 0.73, 0.72, 0.35, 0.42, 9.04,
"05:Q1", 6.51, 0.5, 0.73, 0.71, 0.36, 0.39, 9.21,
"05:Q2", 6.7, 0.53, 0.77, 0.72, 0.37, 0.4, 9.49,
"05:Q3", 6.91, 0.54, 0.83, 0.73, 0.38, 0.41, 9.79,
"05:Q4", 7.1, 0.57, 0.79, 0.74, 0.39, 0.42, 10,
"06:Q1", 7.44, 0.58, 0.79, 0.72, 0.43, 0.42, 10.38,
"06:Q2", 7.76, 0.59, 0.8, 0.74, 0.44, 0.42, 10.75,
"06:Q3", 8.05, 0.6, 0.82, 0.75, 0.45, 0.44, 11.11,
"06:Q4", 8.23, 0.6, 0.82, 0.77, 0.48, 0.41, 11.31,
"07:Q1", 8.42, 0.61, 0.79, 0.76, 0.51, 0.4, 11.5,
"07:Q2", 8.71, 0.62, 0.81, 0.8, 0.51, 0.41, 11.85,
"07:Q3", 8.93, 0.63, 0.82, 0.82, 0.53, 0.41, 12.13,
"07:Q4", 9.1, 0.65, 0.82, 0.84, 0.55, 0.42, 12.37,
"08:Q1", 9.23, 0.66, 0.81, 0.84, 0.58, 0.42, 12.54,
"08:Q2", 9.27, 0.68, 0.81, 0.85, 0.59, 0.4, 12.6,
"08:Q3", 9.29, 0.69, 0.81, 0.86, 0.61, 0.41, 12.68,
"08:Q4", 9.26, 0.71, 0.79, 0.87, 0.64, 0.41, 12.67,
"09:Q1", 9.14, 0.71, 0.77, 0.84, 0.66, 0.41, 12.53,
"09:Q2", 9.06, 0.71, 0.74, 0.82, 0.68, 0.39, 12.41,
"09:Q3", 8.94, 0.71, 0.74, 0.81, 0.69, 0.38, 12.28,
"09:Q4", 8.84, 0.71, 0.72, 0.8, 0.72, 0.38, 12.17,
"10:Q1", 8.83, 0.7, 0.7, 0.76, 0.76, 0.36, 12.12,
"10:Q2", 8.7, 0.68, 0.7, 0.74, 0.76, 0.35, 11.94,
"10:Q3", 8.61, 0.67, 0.71, 0.73, 0.78, 0.34, 11.84,
"10:Q4", 8.45, 0.67, 0.71, 0.73, 0.81, 0.34, 11.71,
"11:Q1", 8.54, 0.64, 0.71, 0.7, 0.84, 0.33, 11.75,
"11:Q2", 8.52, 0.62, 0.71, 0.69, 0.85, 0.33, 11.73,
"11:Q3", 8.4, 0.64, 0.73, 0.69, 0.87, 0.33, 11.66,
"11:Q4", 8.27, 0.63, 0.73, 0.7, 0.87, 0.33, 11.54,
"12:Q1", 8.19, 0.61, 0.74, 0.68, 0.9, 0.32, 11.44,
"12:Q2", 8.15, 0.59, 0.75, 0.67, 0.91, 0.31, 11.38,
"12:Q3", 8.03, 0.57, 0.77, 0.67, 0.96, 0.31, 11.31,
"12:Q4", 8.03, 0.56, 0.78, 0.68, 0.97, 0.32, 11.34,
"13:Q1", 7.93, 0.55, 0.79, 0.66, 0.99, 0.31, 11.23,
"13:Q2", 7.84, 0.54, 0.81, 0.67, 0.99, 0.3, 11.15,
"13:Q3", 7.9, 0.54, 0.85, 0.67, 1.03, 0.3, 11.28,
"13:Q4", 8.05, 0.53, 0.86, 0.68, 1.08, 0.32, 11.52,
"14:Q1", 8.17, 0.53, 0.88, 0.66, 1.11, 0.31, 11.65,
"14:Q2", 8.1, 0.52, 0.91, 0.67, 1.12, 0.32, 11.63,
"14:Q3", 8.13, 0.51, 0.93, 0.68, 1.13, 0.33, 11.71,
"14:Q4", 8.17, 0.51, 0.96, 0.7, 1.16, 0.34, 11.83,
"15:Q1", 8.17, 0.51, 0.97, 0.68, 1.19, 0.33, 11.85,
"15:Q2", 8.12, 0.5, 1.01, 0.7, 1.19, 0.34, 11.85,
"15:Q3", 8.26, 0.49, 1.05, 0.71, 1.2, 0.35, 12.07,
"15:Q4", 8.25, 0.49, 1.06, 0.73, 1.23, 0.35, 12.12,
"16:Q1", 8.37, 0.49, 1.07, 0.71, 1.26, 0.35, 12.25,
"16:Q2", 8.36, 0.48, 1.1, 0.73, 1.26, 0.36, 12.29,
"16:Q3", 8.35, 0.47, 1.14, 0.75, 1.28, 0.37, 12.35,
"16:Q4", 8.48, 0.47, 1.16, 0.78, 1.31, 0.38, 12.58,
"17:Q1", 8.63, 0.46, 1.17, 0.76, 1.34, 0.37, 12.73,
"17:Q2", 8.69, 0.45, 1.19, 0.78, 1.34, 0.38, 12.84,
"17:Q3", 8.74, 0.45, 1.21, 0.81, 1.36, 0.39, 12.96,
"17:Q4", 8.88, 0.44, 1.22, 0.83, 1.38, 0.39, 13.15,
"18:Q1", 8.94, 0.44, 1.23, 0.82, 1.41, 0.39, 13.21,
"18:Q2", 9, 0.43, 1.24, 0.83, 1.41, 0.39, 13.29,
"18:Q3", 9.14, 0.42, 1.27, 0.84, 1.44, 0.4, 13.51,
"18:Q4", 9.12, 0.41, 1.27, 0.87, 1.46, 0.41, 13.54,
"19:Q1", 9.24, 0.41, 1.28, 0.85, 1.49, 0.4, 13.67,
"19:Q2", 9.41, 0.4, 1.3, 0.87, 1.48, 0.41, 13.86
)Question 4
h <- household %>% mutate(qstep = case_when(
str_detect(Quarter,'Q1') ~ 1,
str_detect(Quarter,'Q2') ~ 2,
str_detect(Quarter,'Q3') ~ 3,
str_detect(Quarter,'Q4') ~ 4
))
h$qstep <- as.numeric(h$qstep)
ggplot(h, aes(Credit.Card, Student.Loan, group = qstep, color = qstep)) +
geom_line() +
geom_segment(aes(xend = Credit.Card, yend = Student.Loan)) +
geom_point() +
geom_text(aes(x = .9, label = qstep)) +
transition_reveal(qstep) +
ease_aes('linear')
Question 5
h <- household %>% mutate(yr = substr(Quarter, 1,2)) %>% mutate(date = case_when(
str_detect(Quarter,'Q1') ~ "01.01.",
str_detect(Quarter,'Q2') ~ "01.04.",
str_detect(Quarter,'Q3') ~ "01.07.",
str_detect(Quarter,'Q4') ~ "01.10.")) %>%
mutate(qstep = case_when(
str_detect(Quarter,'Q1') ~ "Q1",
str_detect(Quarter,'Q2') ~ "Q2",
str_detect(Quarter,'Q3') ~ "Q3",
str_detect(Quarter,'Q4') ~ "Q4"))
h <- within(h, date <- paste(date,yr, sep = ''))
h$date <- as.Date(h$date, format="%d.%m.%y")
ggplot(h, aes(date, Student.Loan)) + geom_line()
Question 6
h <- household %>% mutate(yr = substr(Quarter, 1,2)) %>% mutate(date = case_when(
str_detect(Quarter,'Q1') ~ "01.01.",
str_detect(Quarter,'Q2') ~ "01.04.",
str_detect(Quarter,'Q3') ~ "01.07.",
str_detect(Quarter,'Q4') ~ "01.10.")) %>%
mutate(qstep = case_when(
str_detect(Quarter,'Q1') ~ "Q1",
str_detect(Quarter,'Q2') ~ "Q2",
str_detect(Quarter,'Q3') ~ "Q3",
str_detect(Quarter,'Q4') ~ "Q4"))
h <- within(h, date <- paste(date,yr, sep = ''))
h$date <- as.Date(h$date, format="%d.%m.%y")
ggplot(h, aes(date, Student.Loan)) +
geom_line() +
geom_segment(aes(xend = date, yend = Student.Loan)) +
transition_reveal(date) +
ease_aes('linear')
Question 7
ggplot(h, aes(date, Student.Loan)) +
geom_line() +
geom_segment(aes(xend = date, yend = Student.Loan)) +
geom_point() +
geom_text(aes(label=Student.Loan)) +
transition_reveal(date) +
ease_aes('linear')
Question 8
h <- household %>% mutate(yr = substr(Quarter, 1,2)) %>% mutate(date = case_when(
str_detect(Quarter,'Q1') ~ "01.01.",
str_detect(Quarter,'Q2') ~ "01.04.",
str_detect(Quarter,'Q3') ~ "01.07.",
str_detect(Quarter,'Q4') ~ "01.10.")) %>%
mutate(qstep = case_when(
str_detect(Quarter,'Q1') ~ "Q1",
str_detect(Quarter,'Q2') ~ "Q2",
str_detect(Quarter,'Q3') ~ "Q3",
str_detect(Quarter,'Q4') ~ "Q4"))
h <- within(h, date <- paste(date,yr, sep = ''))
h$date <- as.Date(h$date, format="%d.%m.%y")
h <- h %>% gather(key = Debt_Type, value = Debt, 2:4)
ggplot(h, aes(date, Debt, color = Debt_Type)) +
geom_line() +
geom_segment(aes(xend = date, yend = Debt)) +
transition_reveal(date) +
ease_aes('linear')
Question 9
#mortgage and total are most correlated
corr <- cor(household[2:8])
h <- household %>% mutate(yr = substr(Quarter, 1,2)) %>% mutate(date = case_when(
str_detect(Quarter,'Q1') ~ "01.01.",
str_detect(Quarter,'Q2') ~ "01.04.",
str_detect(Quarter,'Q3') ~ "01.07.",
str_detect(Quarter,'Q4') ~ "01.10."))
h <- within(h, date <- paste(date,yr, sep = ''))
h$date <- as.Date(h$date, format="%d.%m.%y")
h <- h %>% select(date, yr, Mortgage, Total) %>% gather(key=Debt_Type, value = Debt, Mortgage, Total)
h$yr <- as.numeric(h$yr)
ggplot(h, aes(date, Debt, color = Debt_Type)) +
geom_line() +
geom_segment(aes(xend = date, yend = Debt)) +
transition_reveal(yr) +
ease_aes('linear')
Question 10
h <- household %>% mutate(yr = substr(Quarter, 1,2)) %>% mutate(date = case_when(
str_detect(Quarter,'Q1') ~ "01.01.",
str_detect(Quarter,'Q2') ~ "01.04.",
str_detect(Quarter,'Q3') ~ "01.07.",
str_detect(Quarter,'Q4') ~ "01.10.")) %>%
mutate(qstep = case_when(
str_detect(Quarter,'Q1') ~ "Q1",
str_detect(Quarter,'Q2') ~ "Q2",
str_detect(Quarter,'Q3') ~ "Q3",
str_detect(Quarter,'Q4') ~ "Q4"))
h <- within(h, date <- paste(date,yr, sep = ''))
h$date <- as.Date(h$date, format="%d.%m.%y")
h <- h %>% select(date, Other, Total) %>% gather(Debt_Type, Debt, Other, Total)
ggplot(h, aes(date, Debt, color = Debt_Type)) +
geom_line() +
geom_segment(aes(xend = date, yend = Debt)) +
transition_reveal(date) +
ease_aes('linear')
h <- household %>% mutate(yr = substr(Quarter, 1,2)) %>% mutate(date = case_when(
str_detect(Quarter,'Q1') ~ "01.01.",
str_detect(Quarter,'Q2') ~ "01.04.",
str_detect(Quarter,'Q3') ~ "01.07.",
str_detect(Quarter,'Q4') ~ "01.10.")) %>%
mutate(qstep = case_when(
str_detect(Quarter,'Q1') ~ "Q1",
str_detect(Quarter,'Q2') ~ "Q2",
str_detect(Quarter,'Q3') ~ "Q3",
str_detect(Quarter,'Q4') ~ "Q4"))
h <- within(h, date <- paste(date,yr, sep = ''))
h$date <- as.Date(h$date, format="%d.%m.%y")
h <- h %>% select(date, Student.Loan, Total) %>% gather(Debt_Type, Debt, Student.Loan, Total)
ggplot(h, aes(date, Debt, color = Debt_Type)) +
geom_line() +
geom_segment(aes(xend = date, yend = Debt)) +
transition_reveal(date) +
ease_aes('linear')
h <- household %>% mutate(yr = substr(Quarter, 1,2)) %>% mutate(date = case_when(
str_detect(Quarter,'Q1') ~ "01.01.",
str_detect(Quarter,'Q2') ~ "01.04.",
str_detect(Quarter,'Q3') ~ "01.07.",
str_detect(Quarter,'Q4') ~ "01.10.")) %>%
mutate(qstep = case_when(
str_detect(Quarter,'Q1') ~ "Q1",
str_detect(Quarter,'Q2') ~ "Q2",
str_detect(Quarter,'Q3') ~ "Q3",
str_detect(Quarter,'Q4') ~ "Q4"))
h <- within(h, date <- paste(date,yr, sep = ''))
h$date <- as.Date(h$date, format="%d.%m.%y")
h <- h %>% select(date, Mortgage, Student.Loan) %>% gather(Debt_Type, Debt, Student.Loan, Mortgage)
ggplot(h, aes(date, Debt, color = Debt_Type)) +
geom_line() +
geom_segment(aes(xend = date, yend = Debt)) +
transition_reveal(date) +
ease_aes('linear')